00010	C*****  SUBRS NOTES, BEAMS, BMX  ***********
00055	
00100		SUBROUTINE NOTES
00200		COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
00300		COMMON/SCX/RHY(4),JALPHA(12),JX,RA,JZ,IRHY,RB,KA,KB,IZ
00310		COMMON /XRN/RN(4000)
00400		COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA
00500		1,DBST,NFLG,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
00700		COMMON /POS/POS1,POS2
00710		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK
00730		DIMENSION R(8,100)
00740		EQUIVALENCE (R,RN(3001))
00750		DATA ACMV/2.3/
00760		POS1=0
00770		POS2=200
00800	444	FORMAT(' TYPE POS1, POS2'/)
00810		CALL SETUP
00820		IF(RN(3921).GE.0)GO TO 8
00830	C SKIPS IF USING SETUP ON STAFF 4
00900	4333	TYPE 444
01100		ACCEPT F78F,POS1,POS2
01200		IF(POS2.EQ.0)POS2=200.
01250		IF(POS1.GE.POS2)GO TO 4333
01300	8	KN=0
01400		IRHY=0
01500	C  IZ=# OF ITEMS FROM SCANR*******
01600		IZ=I-1
01650		IF(IZ.GT.50)IZ=50
01675	C  LIMIT OF 50 ITEMS
01700		CLF=1
01800		JQX=0
01900		D=(POS2-POS1)/I
02000	C   D WILL SPACE ALL ITEMS EVENLY FOR NOW
02100	
02200	C   K=COUNTER FOR USEFUL ITEMS (OMITS CLEFS)
02400		K=1
02500		KQ=1
02600	C   LOOPS TO 7333 
02700	7	JG=0
02800		X=V(KQ)
02900		ACC=0
03000		RA=2.
03100		IF(X.LT.0)GO TO 86
03200	C  JUMP IF A CLEF OR BAR OR METER
03300		IRHY=IRHY+1
03400	C   ADDS A RHYTHMIC UNIT
03500		GO TO 2333
03505	86	DO 89 LL=5,8
03510	89	R(LL,K)=0
03515	C   TO CLEAR END OF ITEM
03520	C  TO CLEAR LAST PARAMS IN SOME ITEMS LATER
03600		IF(AMOD(X,100.0).EQ.-99.)GO TO 84
03700	C   JUMP IF A CLEF 
03750		IF(X.LT.-599.AND.X.GT.-610)GO TO 84
03775	C  FOUND AN EXTENDED BARLINE?
03800		IF(X.LT.-1.)GO TO 2333
03900	C  JUMP IF IT'S A DBLSTP
04000		RA=18.
04100		L=-X*100.
04200		Y=L
04300		R(5,K)=-(X+Y/100.)*10000.+.0001
04400	C   GETS BOTTOM NUM OF METER
04500		X=85.
04600		GO TO 85
04700	84	T=CLF
04800		CLF=-(99.+X)/100.
04850		RZ=X
04900		X=85.
05000	C   WILL SKIP LATER
05100		Y=CLF
05150		LL=Y
05200		RA=3.
05300		IF(LL.NE.5)GO TO 83
05400	C   CLF5 = BAR LINE
05500		RA=4.
05700		Y=1.
05710		IF(LL.NE.CLF)Y=-599.-RZ
05720	C 'M'=1 STF.  'M2'=2 STAVES, ETC.
05790	831	CLF=T
05800		GO TO 85
05900	83	IF(Y.LT.10.)GO TO 851
06000	C  NOW A KSIG.
06100		RA=7.
06200		Y=Y/10.
06300		IF(Y.GT.10.)Y=10.-Y
06400	C  CHANGES FLAT TO NEG.
06600		R(5,K)=T-1
06740		GO TO 831
06800	851	IF(JQX.NE.0)Y=Y+100.
06900		JQX=-1
07000	C   AFTER THE FIRST TIME, THEN MINICLEFS
07010		R(5,K)=Y
07020		Y=0
07030	C  FOR NEW CLEF ROUTINE
07100	85	R(4,K)=Y
07200	2333	R(3,K)=STAFF
07300		IF(X.GT.0)KN=KN+1
07400		R(2,K)=KN*D+POS1
07500		IF(X.EQ.85.)GO TO 7333
07600	C  JUMP IF REST, METER, CLEF OR BAR
07700		RA=1.
07800		IF(X.GT.0)GO TO 2133
07900		X=-X
08000		JG=-1
08100	C  DBLSTOP=-1
08200		R(8,K)=-1.
08300	2133	IF(X.LT.100.)GO TO 433
08400		IF(X.LT.1000.)GO TO 233
08500		IF(X.LT.10000.)GO TO 333
08600		ACC=3.
08700	C  NATURAL
08800		X=X-10000.
08900		GO TO 433
09000	333	ACC=2.
09100	C  SHARP
09200		X=X-1000.
09300		GO TO 433
09400	233	ACC=1.
09500	C  FLAT
09600		X=X-100.
09700	433	Y=AMOD(X,12.0)
09800		IF(Y.EQ.0)Y=12.
09900		J=(Y+1)/2
10000		IF(Y.GT.5.)J=(Y+2)/2
10100		IF(ACC.EQ.0.OR.ACC.EQ.3.)GO TO 133
10200		IF(ACC.EQ.1.)GO TO 533
10300		IF(Y.EQ.1.OR.Y.EQ.6.)J=J-1
10400		GO TO 133
10500	533	J=J+1
10600	133	IF(CLF.EQ.2)GO TO 633
10700		IF(CLF.EQ.3)GO TO 733
10800		IF(CLF.EQ.4)GO TO 833
10900		KA=4
11000		KB=0
11100		GO TO 933
11200	633	KA=2
11300		KB=-2
11400		GO TO 933
11500	733	KA=3
11600		KB=-1
11700		GO TO 933
11800	833	KA=2
11900		KB=-6
12000	933	L=(X-1)/12+1
12100	C   L IS OCTAVE
12200		N=(L-KA)*7+J+KB
12300		T=10.
12400		IF(N.GE.7)T=20.
12500	C  FOR STEM DIRECTIONS - 'B' AND HIGHER HAVE STEMS DOWN.
12600		R(4,K)=N
12700	C  N=NOTE #
12800		IF(JG.EQ.0)GO TO 3133
12900	C  JUMP IF NOT DBLSTOP
13000		IF(R(5,K-1).GE.10.)MX=K-1
13100	C  MX=1ST NOTE OF CHRD
13200		T=0
13300		L=K-MX
13400		IF(N.LT.R(4,MX))L=-L
13500		R(7,MX)=L
13600	C L+=STEM UP, L-=STEM DOWN ... USED AT END OF NOTES.
13700		RZ=ABS(R(4,MX)-FLOAT(N))-1.
13800	C  EXTENDS THE STEM!
13900		IF(RZ.LT.1.)RZ=1.
14000		R(8,MX)=RZ
14100	3133	R(5,K)=ACC+T
14200	
14300	7333	R(1,K)=RA
14400	87	K=K+1
14500		KQ=KQ+1
14600		IF(KQ.LE.IZ)GO TO 7
14700	
14800		IZ=K-1
14900	C  IZ IS NOW REALLY THE NUMBER OF ITEMS TO BE PROCESSED
15100	C  NEXT ADJUSTS PLACEMENT OF ACCIDENTALS AND 2NDS.
15200		K=1
15210	1	RX=R(7,K)
15300		IF(RX.EQ.0.OR.R(1,K).EQ.2.)GO TO 2
15400	C  JUMP IF NO CHRD COMING
15500		Y=0
15600	C  Y=ACCI. MOVER
15700		IF(RX.GT.0)GO TO 3
15800	C  JUMP IF STEM IS UP
15900		RA=R(5,K)
16000		IF(RA.GE.10.AND.RA.LT.20.)R(5,K)=RA+10.
16100	C  PUTS STEM DOWN IF IT WASN'T
16200		L=K-RX
16300		R(7,K)=0
16400		M=K
16500		RD=0
16600	4	RA=R(4,K)
16700		IF(RD-RA.GT.4.)Y=0
16900		RC=0
17100	C  INTERVAL TO PREVIOUS NOTE
17200		AMD=AMOD(R(5,K),10.0)
17220	C  CHECK ON USE OF N ELSEWHERE
17250		N=K+1
17300		IF(K.LT.L)RC=RA-R(4,N)
17400	C  INTERVAL TO NEXT NOTE
17500		IF(RC+R(6,K).NE.1.)GO TO 6
17600		R(6,N)=20
17700	C  PUSHES NOTE TO LEFT 
17800		IF(AMD.EQ.0)GO TO 5
17900		IF(Y.EQ.0)Y=Y+.23
18000	C  MOVE ACCI ONLY WITH 1ST SMALL INTERVAL
18100	6	IF(AMD.EQ.0)GO TO 5
18200	C  JUMP IF NO ACCI.
18300		IF(Y.GE.1.)Y=0
18400		R(5,K)=R(5,K)+Y
18500		IF(Y.EQ.0.OR.(R(6,N).EQ.20.AND.Y.EQ..23))RD=RA
18600	C  RESETS SOURCE FOR INTERVALS
18710		IF(R(6,N).EQ.0.AND.AMOD(R(5,N),10.0).NE.0)Y=Y+.23
18800		IF(R(6,K).EQ.20)Y=Y+.23
18900	5	K=N
19000		IF(K.GT.L)GO TO 22
19100		GO TO 4
19200	
19300	3	DO 30 M=2,IZ
19400		L=M-1
19500	30	IF(R(4,M)-R(4,L)+R(6,L).EQ.1..AND.R(2,M).EQ.
19600		1 R(2,L))R(6,M)=10
19700	C  MOVES NOTE TO RIGHT OF STEM WHEN 2ND.
19800		L=K+R(7,K)+.1
19900	C  THE STEM IS UP
20000		RA=R(5,K)
20100		IF(RA.GE.20.)R(5,K)=RA-10.
20200	C  PUTS STEM UP IF IT WASN'T
20300		M=L
20400		RD=0
20500		R(7,K)=0
20600	40	RA=R(4,L)
20700	60	IF(AMOD(R(5,L),10.0).EQ.0)GO TO 50
20800	C  JUMP IF NO ACCI.
21000		RC=0
21200		IF(L.LT.M)RC=R(4,L+1)-RA
21300	C  INTERVAL TO NOTE ABOVE
21400		IF(RD-RA.GT.4.)Y=0
21500	C  MOVES ACCIS. BACK AGAIN
21600		R5=R(5,L)+Y
21700		IF(R(6,L).EQ.10)R5=R5+.23
21800		R(5,L)=R5
21900		IF(Y.EQ.0)RD=RA
22000	C  RESETS SOURCE INTERVAL
22100		Y=Y+.23
22200	50	L=L-1
22300		IF(L.GE.K)GO TO 40
22400		K=L+1
22500		GO TO 22
22600	
22700	2	K=K+1
22800	22	IF(K.LE.IZ)GO TO 1
23100	C  ABOVE NEEDED IN OTHER ROUTINES???
23300		END
23400	
50000		SUBROUTINE BMX(RA)
50050	C  RA=NUMB. OF TAILS
50060		DIMENSION R(8,100)
50080		COMMON /XRN/RN(4000)
50090		EQUIVALENCE (R,RN(3001))
50100		COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
50200		COMMON/SCX/RHY(4),JALPHA(12),JX,U,JZ,IRHY,JD,KA,KB,IZ
50300		COMMON /SC/J,L,MK
50400		1 ,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG,IXX,ISEMI,IQT
50500		1 ,VX(50),IAMP,K,KN,M,MODE,IBLA
50600	CC	DATA RBM/2.7/
50700		M=IZ
50800		DO 1 L=KN,K
50900	1	VX(L)=AMOD(R(7,L),10.0)
51000		VX(K+1)=0
51100	C   CLEARS IT FOR ROUTINE AT '3'
51200		JB=KN
51300	6	DO 2 L=JB,K
51400		IF(VX(L).LE.RA)GO TO 2
51500	C  SKIP IF EQ. TO PRESENT BEAM
51600		RB=VX(L)
51700	4	IZ=IZ+1
51800		B=20.
51900		DO 11 JD=L,K
52000		IF(VX(JD).NE.RA)GO TO 11
52100		B=10.
52200		GO TO 12
52300	11	CONTINUE
52400	C  FINDS NEED FOR BEAM TO LEFT 
52500	12	B=B+RA
52700		DO 5 JE=4,6
52800	5	R(JE,IZ)=R(JE,M)
52900		R(7,IZ)=R(7,M)+RB-RA*2.
53000	C  ADDS RIGHT NUM. OF BEAMS
53300		JE=-1
53400		DO 3 JD=JB,K
53500		IF(VX(JD).NE.RB)GO TO 3
53600		JC=JD
53700	C  JC IS BEGINNING OF NEW BEAMS
53800	77	IF(VX(JD).NE.VX(JD+1))GO TO 7
53900	C  ARE THERE 2 RHYTHMS THE SAME?
54000		JE=JE+1
54100		JD=JD+1
54200		GO TO 77
54300	3	CONTINUE
54400	7	IF(JE.GE.0.OR.(JD.NE.KN.AND.JD.NE.K))GO TO 10
54500	C   IF NO UNATTACHED BEAMS, JUMP
54650	CC	RB=RSTJC
54750	CC	IF(B.NE.10)RB=-RB
54800	CC	R(2,IZ)=R(2,JD)+RBM*RB
54862		B=-B
54875	C PARTIAL, UNATTACHED BEAM IS PLACED AUTOMATICALLY IN ITMSUB.
54900		GO TO 8
55000	C  PARTIAL BEAM IS ON RIGHT(+) OR LEFT(-).  RBM IS LENGTH.
55100	10	IF(JC.EQ.JB.AND.B.NE.20.)JC=JD
55200	C PUTS BEAMS IN RIGHT PLACE.
55300		R(2,IZ)=R(2,JC)
55400	C  THIS WILL BE POS.3
55410		R(3,IZ)=RA
55455	C  DISPLACES
55500		GO TO 8
55600	2	CONTINUE
55700		RETURN
55800	8	JB=JD+1
55810		R(8,IZ)=B
55855	C  FINDS SIDE (L,R) FOR PARTIAL BEAM
55900		R(1,IZ)=999.
56100	C  FOR NEW DISPLACEMENT
56200		IF(JB.LT.K)GO TO 6
56400		END